The goal of this document is to provide a fairly comprehensive
translation of highcharts.js plots within R. It attempts to combine
references found on the official highcharter website, in
addition to filling in gaps with highcharts.js examples,
and other plots.
This page is heavily influenced by Joshua Kunst’s blog, documentation, and issue responses.
Theme, Layout, & Toggles
Theme
thm <- hc_theme(
colors = rev(c(
"#003f5c", "#2f4b7c", "#665191", "#a05195", "#d45087", "#f95d6a",
"#ff7c43", "#ffa600"
)), chart = list(
backgroundColor = "var(--page-background)"
), xAxis = list(
labels = list(style = list(color = "var(--text-color)")),
gridLineDashStyle = "Dash",
gridLineWidth = 1, gridLineColor = "var(--code-block-background)", lineColor = "var(--text-color)",
minorGridLineColor = "var(--text-color)", tickColor = "var(--text-color)", tickWidth = 1,
title = list(style = list(color = "var(--text-color)"))
), yAxis = list(
labels = list(style = list(color = "var(--text-color)")),
gridLineDashStyle = "Dash",
gridLineWidth = 1, gridLineColor = "var(--code-block-background)", lineColor = "var(--text-color)",
minorGridLineColor = "var(--text-color)", tickColor = "var(--text-color)", tickWidth = 1,
title = list(style = list(color = "var(--text-color)"))
), legendBackgroundColor = "var(--page-background)",
background2 = "var(--page-background)", dataLabelsColor = "var(--text-color)", textColor = "var(--text-color)",
contrastTextColor = "var(--text-color)", maskColor = "rgba(255,255,255,0.3)",
title = list(style = list(color = "var(--text-color)")), subtitle = list(
style = list(color = "var(--text-color)")
), legend = list(
itemStyle = list(
color = "var(--text-color)"
), itemHoverStyle = list(color = "var(--text-color)"),
itemHiddenStyle = list(color = "var(--text-color)")
)
)
thm <- hc_theme_merge(
hc_theme_darkunica(),
thm
)
options(
highcharter.theme = thm,
highcharter.color_palette = rev(c(
"#003f5c", "#2f4b7c", "#665191", "#a05195", "#d45087", "#f95d6a",
"#ff7c43", "#ffa600"
))
)
highcharter::highcharts_demo()Creating Multiple Toggles
# https://github.com/zac-garland/highchart.extensions/blob/master/R/add_multi_drop.R
add_multi_drop <- function(hc, selectors, selected = NULL) {
# first we create a random id to ensure that if used multiple times, each selector / chart combo has a unique id
rand_id_begin <- paste(sample(letters, 3, replace = FALSE),
sample(letters, 4, replace = FALSE),
sample(letters, 3, replace = FALSE),
collapse = ""
) |> stringr::str_remove_all(" ")
# next we generate the potential list options available in the chart (to ensure that we aren't passing in multiple data sets or trying to attach the data again to the web document)
list_opts <- purrr::map(setNames(selectors, selectors), ~ {
select_name <- .x
hc$x$hc_opts$series |>
purrr::map(~ {
purrr::map(purrr::pluck(.x, "data"), ~ {
purrr::pluck(.x, select_name)
}) |>
unlist()
}) |>
unlist() |>
unique()
})
# generate the select html input elements with their corresponding options
select_options <- list_opts |>
purrr::imap(~ {
htmltools::tags$select(
style = "display:inline-block",
id = paste0(.y, rand_id_begin),
purrr::map(.x, ~ {
if ((!is.null(selected) & .x %in% selected)) {
htmltools::tags$option(value = ., ., `selected` = TRUE)
} else {
htmltools::tags$option(value = ., .)
}
})
)
})
# generate variable declaration statement in javascript using R string interpolation (comparable to es7 `this var: ${var}`)
names(list_opts) |>
purrr::map_chr(~ {
glue::glue("var select_{paste0(.x, rand_id_begin)} = document.getElementById('{paste0(.x, rand_id_begin)}');")
}) |>
paste(collapse = "") -> var_declaration
# generate shared javascript filter (each chart should be aware of multiple inputs - and share the filter between onchange events)
names(list_opts) |>
purrr::map_chr(~ {
glue::glue("obj.{.x} == select_{paste0(.x, rand_id_begin)}.value")
}) |>
paste(collapse = " & ") -> filter_declaration
# generate the onchange events to monitor each of the inputs
names(list_opts) |>
purrr::map_chr(~ {
glue::glue("select_{paste0(.x, rand_id_begin)}.onchange = updateChart;")
}) |>
paste(collapse = "") -> onchg_events
# create the javascript function for highcharts events, adding in the variable declaration, filters, and events generated from previous steps
js_fun <- "function(){{
var this_chart = this;
// create a cloned data set (to avoid highcharts mutate behavior)
const cloneData = (sample) => {{ return JSON.parse(JSON.stringify(sample));}}
// initialize empty array
const init_data = [];
// loop over chart series and add to data array
this_chart.options.series.map((series,index)=>{{
init_data[index] = cloneData(series.data);
}})
// declare variables
{var_declaration}
// create shared updateChart function
function updateChart(){{
// map the series data to filter based on inputs
init_data.map((series,index)=>{{
new_data = series.filter(function(obj){{
return {filter_declaration}
}});
// only draw if data is available post filter
if(new_data.length>0){{
this_chart.series[index].setData(new_data);
}}
}})
// redraw chart
this_chart.reflow();
}}
// add on change monitor events for dropdowns
{onchg_events}
// updateChart (for first run)
updateChart();
}}"
# add javascript function as an onload event (so we filter down the data in the first view)
highcharter::hc_chart(hc,
events = list(
load = highcharter::JS(glue::glue(js_fun))
)
) |>
htmltools::tagList(
select_options, . # create a html fragment including the dropdowns and chart
) |>
htmltools::browsable() # create a browsable option (shows chart in rstudio or in render)
}
tidy_employment_data <- fpp3::us_employment |>
janitor::clean_names() |>
as_tibble() |>
filter(!str_detect(title, ":")) |>
rename(value = employed) |>
mutate(month = lubridate::as_date(month)) |>
group_by(title) |>
mutate(
yoy = value / lag(value, 12) - 1,
`Three year comp` = value / lag(value, 36) - 1
) |>
gather(key, value, value:`Three year comp`)
tidy_employment_data |>
mutate(month = datetime_to_timestamp(month)) |> # for highcharts date format
highcharter::hchart("line", highcharter::hcaes(month, value, name = title)) |>
hc_xAxis(type = "datetime") |>
add_multi_drop(
selectors = c("title", "key"),
selected = c("Total Private", "Three year comp")
)